home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / dkbuts.zip / ANIMA.BAS < prev    next >
BASIC Source File  |  1991-05-16  |  7KB  |  214 lines
  1. ' Program: ANIMA.BAS
  2. ' By: Dan Farmer
  3. ' Function: Create a sequence of DKB Raytracer script files by replacing
  4. '           tokens in a skeleton file with incremented values specified
  5. '           in a rules list.
  6. '
  7.  
  8.  
  9. COMMON SHARED DEBUG,MAX.LINE.LEN
  10. FALSE=0 : TRUE = NOT FALSE
  11. 'DEBUG = TRUE
  12. MAX.LINE.LEN = 80
  13. MAXPARMS = 9                           ' Allow 9 replaceable tokens
  14. MAXCODE = 200                          ' Lines of skeleton code allowed.
  15. REM $INCLUDE: 'ANIMA.INC'               ' LOAD UDFs (trim, pad, etc.)
  16.  
  17.  
  18. ' Get the root filename from the command line, display usage if no command$
  19. ROOT$=FNTRIM$(COMMAND$)
  20. IF ROOT$="" THEN
  21.     PRINT "ANIMATE By Dan Farmer"
  22.     PRINT "    Usage:"
  23.     PRINT "        ANIMATE filename[.DAT]"
  24.     PRINT "        Where filename is the 5 letter name of the input script"
  25.     PRINT "        file and the root of the numbered output file."
  26.     PRINT "    Example: ANIMATE ANIMA reads file ANIMA.DAT and creates DKB scripts"
  27.     PRINT "             named ANIMA001.DAT, ANIMA002.DAT, etc.
  28.     SYSTEM
  29. END IF
  30.  
  31.  
  32. MAIN:
  33.  
  34. ' Dimension 2 arrays, RULES$(2) dimensioned to hold 2 values for MAXPARMS
  35. '  replaceable parameters, and CODE$(1), dimensioned to buffer MAXCODE
  36. '  lines of code.
  37.     DIM RULES$(MAXPARMS,2) :  DIM CODE$(MAXCODE)
  38.  
  39. ' Initialize indices to the RULE$() array structure
  40.     VALUE=1 : JUMP=2 :
  41.  
  42. ' Parse root name of input file, trimming extension if neccessary.
  43.     IF INSTR(ROOT$,".") THEN ROOT$ = LEFT$(ROOT$,INSTR(ROOT$,".")-1)
  44.     INFILE$=ROOT$+".DAT"
  45.     PRINT "Opening skeleton file ";INFILE$
  46.     OPEN INFILE$ FOR INPUT AS #1               ' OPEN INPUT FILE
  47.  
  48. ' Read number of iterations to perform from 1st line of input file
  49.     A$=""
  50.     WHILE FNTRIM$(A$)=""               ' Skip over blank lines
  51.         LINE INPUT #1, A$
  52.     WEND
  53.     ITERS = VAL(FNTRIM$(MID$(A$,INSTR(A$,"=")+1)))
  54.     IF ITERS = 0 THEN
  55.         CLS
  56.         PRINT "ERROR: Number of iterations was not specified"
  57.         PRINT "       or was specified incorrectly."
  58.         CLOSE
  59.         SYSTEM
  60.     END IF
  61.  
  62.  
  63. ' Input until we come to the block named "RULES:"
  64.     CALL GET.BLOCK.NAMED(1%,A$,"RULES:")
  65.  
  66.  
  67. ' Input until we come to the block named "END_RULES:" and parse out the
  68. ' values of the rules.  The values come in two flavors: the starting value
  69. ' for this particular parameter, and the step rate for it to increase or
  70. ' decrease at.
  71.     RULE.COUNT=0
  72.     WHILE FNTRIM$(A$) <> "END_RULES:"
  73.         IF A$ <> "" AND A$ <> "END_RULES:" THEN
  74.  
  75.             ' Trim any comments from the string
  76.             COMMENT = INSTR(A$,"{")
  77.             IF COMMENT THEN
  78.                 A$=LEFT$(A$,COMMENT-1)   ' Trim to the left of the { character.
  79.             END IF
  80.  
  81.             ' Find initial value for this RP (Default is 1 if not specified)
  82.             TOKEN = INSTR(A$,"=")
  83.             IF TOKEN  THEN
  84.                 RULE.COUNT=RULE.COUNT+1
  85.                 RULES$(RULE.COUNT,VALUE)=FNWORD$(FNLTRIM$(MID$(A$,TOKEN+1)))
  86.             ELSE
  87.                 RULES$(RULE.COUNT,VALUE)="1"
  88.             END IF
  89.  
  90.             ' Find the step rate for this RP (Default is 1 if not specified)
  91.             ' Token separator is the $ sign. ( Single characters are easy to
  92.             ' parse because you only need to use the INSTR function.)
  93.             TOKEN = INSTR(A$,"$")
  94.             IF TOKEN THEN
  95.                 RULES$(RULE.COUNT,JUMP)=FNWORD$(FNLTRIM$(MID$(A$,TOKEN+1)))
  96.             ELSE
  97.                 RULES$(RULE.COUNT,JUMP)="1"
  98.             END IF
  99.  
  100.         END IF
  101.         LINE INPUT #1, A$
  102.     WEND      ' end of input rules routine
  103.  
  104.  
  105.     ' Now, input and buffer the skeleton code block into the CODE$ array.
  106.     CODE.LINES=0
  107.     CALL GET.BLOCK.NAMED(1%,A$,"SKELETON:")
  108.  
  109.     ' Input until end of skeleton block label is found
  110.     WHILE FNTRIM$(A$) <> "END_SKELETON:"
  111.         IF A$ > "" THEN                ' Skip blank lines
  112.             CODE.LINES=CODE.LINES+1    ' Keep track of how many lines of code
  113.             CODE$(CODE.LINES)=A$       ' Buffer the code in CODE$() array.
  114.         END IF
  115.         LINE INPUT #1, A$
  116.     WEND
  117.  
  118. ' This is where we actually write out each DKB script file called for by
  119. ' the memvar ITERS.
  120. FOR J = 1 TO ITERS
  121.  
  122.     ' Increment the filename counter (ANIMA001.DAT ANIMA002.DAT, etc)
  123.  
  124.     ITER$=RIGHT$("000"+FNLTRIM$(STR$(J)),3)    ' Zero pad the filename counter
  125.     OUTFILE$=LEFT$(ROOT$,4)+ITER$+".DAT"       ' Append the counter to root
  126.     CLOSE #2 : OPEN OUTFILE$ FOR OUTPUT AS #2  ' open new output file
  127.     PRINT "Creating file " ;OUTFILE$
  128.  
  129.  
  130.     ' For the 1st created file only, write the rules used out for future
  131.     ' reference.  No sense writing copies to all files, though.
  132.  
  133.     IF J = 1 THEN
  134.         ' First, print the rules given...
  135.         PRINT #2,"{ Rules used for this animation:"
  136.         PRINT #2,"        Iterations = ";ITERS
  137.         FOR I = 1 TO RULE.COUNT
  138.             PRINT #2,"        Increment %";FNLTRIM$(STR$(I));
  139.             PRINT #2," starting at "; RULES$(I,VALUE);" in steps of ";
  140.             PRINT #2,RULES$(I,JUMP)
  141.         NEXT I
  142.         ' Next print the actual skeleton code that was used.
  143.         PRINT #2, " The skelton code used :"
  144.         FOR I=1 TO CODE.LINES
  145.             PRINT #2,CODE$(I)
  146.         NEXT I
  147.         PRINT #2,"*** end of skeleton code *** }"
  148.     END IF
  149.  
  150.  
  151.     ' Replace parameter tokens with actual values and write the skeleton
  152.     ' code out with the new values plugged in.
  153.  
  154.     FOR I = 1 TO CODE.LINES        ' Loop for each line in CODE$()
  155.         TEMP$=CODE$(I)             ' Copy this line of code to a work string
  156.         TOKEN = 0                  ' Initialize a pointer to token in TEMP$
  157.  
  158.         DO WHILE INSTR(TEMP$,"%") > 0  ' Loop for each token in the line
  159.             TOKEN=INSTR(TEMP$,"%")     ' Locate position of token in string
  160.  
  161.             IF TOKEN > 0 THEN          ' If a token was indeed found,
  162.  
  163.                 ' The next line uses the value of the replaceable token
  164.                 ' as an index to the RULES$() array (%1 points to RULE$(1,n)
  165.                 INDEX=VAL(MID$(TEMP$,TOKEN+1,1))
  166.  
  167.                 ' ---  Get value from RULES$() array
  168.                 VAL$=FNLTRIM$(FNFMT$(VAL(RULES$(INDEX,VALUE))))
  169.  
  170.         ' ---  Replace all occurances of this parameter with value
  171.                 CALL REPLACE("%"+FNLTRIM$(STR$(INDEX)),VAL$,TEMP$)
  172.  
  173.             END IF  ' token was found
  174.         LOOP        ' while another token in this line
  175.  
  176.         IF DEBUG THEN PRINT TEMP$      ' Show me what I just did
  177.         PRINT #2, TEMP$                ' Write this line to the output file.
  178.     NEXT I                             ' Next line of skeleton code
  179.  
  180.     ' --- Increment value in RULES$ array for all replaceable tokens.
  181.     FOR I = 1 TO MAXPARMS
  182.         IF RULES$(I,VALUE) > "" THEN
  183.             NEW.VAL = VAL(RULES$(I,VALUE)) + VAL(RULES$(I,JUMP))
  184.             RULES$(I,VALUE)=STR$(NEW.VAL)
  185.         END IF
  186.     NEXT I
  187.  
  188.  
  189.     IF DEBUG THEN
  190.         PRINT "Press any key"
  191.         WHILE INKEY$="":WEND
  192.     END IF
  193. NEXT J                                 ' Next output file
  194.  
  195.  
  196. ' --- Replace all occurances of FIND$ with REPL$ in TARGET$
  197. '
  198. SUB REPLACE(FIND$,REPL$,TARGET$) STATIC
  199.     FOR I = 1 TO 80' LEN(TARGET$)
  200.         IF MID$(TARGET$,I,2) = FIND$ THEN
  201.             TARGET$=LEFT$(TARGET$,I-1)+REPL$+MID$(TARGET$,I+2)
  202.         END IF
  203.     NEXT I
  204. END SUB
  205.  
  206. '===============================
  207. ' Reads from Fileno and discards input until TOKEN is found.
  208. SUB GET.BLOCK.NAMED (FILENO%,X$,TOKEN$) STATIC
  209.     WHILE FNTRIM$(X$) <> TOKEN$
  210.         LINE INPUT #FILENO%, X$
  211.     WEND
  212.     X$=""
  213. END SUB
  214.